perm filename CORD2.F4[CMS,LCS]1 blob
sn#079895 filedate 1974-01-09 generic text, type T, neo UTF8
00100 COMMON IZ,KZ,F
00200 DIMENSION I(1),IA(1000),KC(6),KC7(6),KCN(6),KCN7(6),
00300 1KD(6),KD7(6),KDN(6),KDN7(6),KG(6),KG7(6),KGN(6),
00400 1KGN7(6),KA(6),KA7(6),KAN(6),KAN7(6),KB(6),KB7(6),
00500 1KBN(6),KBN7(6),KE(6),KE7(6),KEN(6),KEN7(6),KF(6),
00600 1KF7(6),KFN(6),KFN7(6),IX(25),IY(25),JX(25),JY(25)
00700 DATA KC/3,3,2,0,1,0/,KCN/3,3,5,5,4,3/,KC7/0,3,2,3,1,0/
00800 1,KCN7/3,3,5,3,4,6/,KD/0,0,0,2,3,2/,KDN/0,0,0,2,3,1/,
00900 1KD7/0,0,0,2,1,2/,KDN7/0,0,0,2,1,1/,KG/3,2,0,0,0,3/,
01000 1KGN/3,5,5,3,3,3/,KG7/3,2,0,0,0,1/,KGN7/3,5,5,3,6,3/,
01100 1KA/0,0,2,2,2,0/,KA7/0,0,2,1,2,0/,KAN/0,0,2,2,1,0/,
01200 1KAN7/0,0,2,2,1,3/,KB/2,2,4,4,4,2/,KB7/0,2,1,2,0,2/,
01300 1KBN/2,2,4,4,3,2/,KBN7/2,2,4,4,3,5/,KE/0,2,2,1,0,0/,
01400 1KE7/0,2,2,1,3,0/,KEN/0,2,2,0,0,0/,KEN7/0,2,2,0,3,0/,
01500 1KF/1,3,3,2,1,1/,KF7/1,3,1,2,4,1/,KFN/1,3,3,1,1,1/,
01600 1KFN7/1,3,3,1,4,1/,IX/100,150,200,250,300,350,100,
01700 1 100,100,100,100,100,100,100,100,100,100,100,100,
01800 1 100,215,215,215,215,190/,IY/420,420,420,420,420,
01900 1 420,420,350,280,210,140,70,0,-70,-140,-210,-280,
02000 1 -350,-420,425,245,105,-35,-245,-385/
02100 DATA JX/100,150,200,250,300,350,350,350,350,350,
02200 1 350,350,350,350,350,350,350,350,350,350,235,
02300 1 235,235,235,260/,JY/-420,-420,-420,-420,-420,-420,
02400 1 420,350,280,210,140,70,0,-70,-140,-210,-280,-350,
02500 1 -420,425,245,105,-35,-245,-385/
02600 Q=0
02700 2 TYPE 4
02800 4 FORMAT(' STARTING POINTS FOR X,Y,OR SIZE?'/)
02900 ACCEPT 3,IZ,KZ,F
03000 3 FORMAT(2I,F)
03100 IF(F.EQ.0)F=1
03200 GO TO 111
03300 1 IF(Q.EQ.1)GO TO 2
03400 111 TYPE 5
03500 5 FORMAT(' TYPE CHORD NAME'/)
03600 ACCEPT 10,A,B,N
03700 IF(A.EQ.'S')CALL SAVER(I)
03800 IF(A.EQ.'X')Q=1
04000 IF(Q.EQ.0.OR.A.EQ.'X')CALL DPYSET(2,IA,1000)
04001 IF(A.EQ.'X')GO TO 2
04100 10 FORMAT(2A1,I)
04200 DO 12 K=1,25
04300 L1=IX(K)*F+IZ
04400 L2=IY(K)*F+KZ
04500 L3=JX(K)*F+IZ
04600 L4=JY(K)*F+KZ
04700 12 CALL ALINE(L1,L2,L3,L4)
04800 IF(B.EQ.'7')N=7
04900 IF(A.EQ.'C')GO TO 20
05000 IF(A.EQ.'D')GO TO 25
05100 IF(A.EQ.'G')GO TO 30
05200 IF(A.EQ.'A')GO TO 50
05300 IF(A.EQ.'B')GO TO 55
05400 IF(A.EQ.'E')GO TO 60
05500 IF(A.EQ.'F')GO TO 65
05600 GO TO 1
05700 20 IF(B.EQ.'N')GO TO 33
05800 IF(N.EQ.7)CALL X(KC7)
05900 IF(N.EQ.0)CALL X(KC)
06000 GO TO 1
06100 33 IF(N.EQ.7)CALL X(KCN7)
06200 IF(N.EQ.0)CALL X(KCN)
06300 GO TO 1
06400 25 IF(B.EQ.'N')GO TO 44
06500 IF(N.EQ.7)CALL X(KD7)
06600 IF(N.EQ.0)CALL X(KD)
06700 GO TO 1
06800 44 IF(N.EQ.7)CALL X(KDN7)
06900 IF(N.EQ.0)CALL X(KDN)
07000 GO TO 1
07100 30 IF(B.EQ.'N')GO TO 11
07200 IF(N.EQ.7)CALL X(KG7)
07300 IF(N.EQ.0)CALL X(KG)
07400 GO TO 1
07500 11 IF(N.EQ.7)CALL X(KGN7)
07600 IF(N.EQ.0)CALL X(KGN)
07700 GO TO 1
07800 50 IF(B.EQ.'N')GO TO 66
07900 IF(N.EQ.7)CALL X(KA7)
08000 IF(N.EQ.0)CALL X(KA)
08100 GO TO 1
08200 66 IF(N.EQ.7)CALL X(KAN7)
08300 IF(N.EQ.0)CALL X(KAN)
08400 GO TO 1
08500 55 IF(B.EQ.'N')GO TO 67
08600 IF(N.EQ.7)CALL X(KB7)
08700 IF(N.EQ.0)CALL X(KB)
08800 GO TO 1
08900 67 IF(N.EQ.7)CALL X(KBN7)
09000 IF(N.EQ.0)CALL X(KBN)
09100 GO TO 1
09200 60 IF(B.EQ.'N')GO TO 68
09300 IF(N.EQ.7)CALL X(KE7)
09400 IF(N.EQ.0)CALL X(KE)
09500 GO TO 1
09600 68 IF(N.EQ.7)CALL X(KEN7)
09700 IF(N.EQ.0)CALL X(KEN)
09800 GO TO 1
09900 65 IF(B.EQ.'N')GO TO 69
10000 IF(N.EQ.7)CALL X(KF7)
10100 IF(N.EQ.0)CALL X(KF)
10200 GO TO 1
10300 69 IF(N.EQ.7)CALL X(KFN7)
10400 IF(N.EQ.0)CALL X(KFN)
10500 GO TO 1
10600 END